home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 30 / Amiga Format AFCD30 (Sep 1998, Issue 114).iso / -seriously_amiga- / sound / autodrums / autodrum-e.rexx < prev    next >
OS/2 REXX Batch file  |  1998-06-22  |  17KB  |  606 lines
  1. /*************************************************************************/
  2. /* $VER: AutoDrum 5.0                                                    */
  3. /*************************************************************************/
  4. /*
  5. gui_file = arg(1)
  6. */
  7. /* gui_file = 'ram:rexx/gui/octamed-d.gui' */
  8. gui_file = 'rexx:gui/octamed-d.gui'
  9.  
  10. IF EXISTS("libs:rexxsupport.library") THEN DO
  11.     IF ~SHOW("L","rexxsupport.library") THEN
  12.         IF ~ADDLIB("rexxsupport.library",0,-30,0) THEN EXIT
  13. END
  14. ELSE EXIT
  15.  
  16. IF EXISTS("libs:rexxreqtools.library") THEN DO
  17.     IF ~SHOW("L","rexxreqtools.library") THEN
  18.         IF ~ADDLIB("rexxreqtools.library",0,-30) THEN EXIT
  19. END
  20. ELSE EXIT
  21.  
  22. OPTIONS RESULTS
  23. OPTIONS FAILAT 10
  24.  
  25. SIGNAL ON SYNTAX
  26. SIGNAL ON FAILURE 
  27.  
  28. /* Get the GUI file from the user */
  29. IF gui_file = '' THEN
  30.   DO
  31.     gui_file=rtfilerequest('REXX:gui',,'Varexx Request','_Load','rt_reqpos=reqpos_centerscr rtfi_matchpat=#?.gui rtfi_flags=freqf_patgad')
  32.     IF gui_file = '' THEN EXIT
  33.   END
  34.  
  35. /* Check Varexx is loaded if not load it */
  36. IF SHOW( 'p', 'VAREXX' ) ~= 1 THEN DO
  37.     ADDRESS COMMAND "run >NIL: varexx"
  38.     ADDRESS COMMAND "WaitForPort VAREXX"
  39. END
  40. ADDRESS VAREXX
  41.  
  42. IF OPENPORT("HOLLY") = 0 THEN DO
  43.     CALL rtezrequest "Could not open a port.",, "Varexx Error"
  44.     EXIT
  45. END
  46.  
  47. /*  'load ' gui_file 'HOLLY'  */ /*normal screen */
  48. 'load ' gui_file 'HOLLY PS=OCTAMED'  /*go to octamed screen */
  49.  
  50. vhost = RESULT
  51. /* say rc externerror */
  52. ADDRESS VALUE vhost
  53.  
  54. show
  55.  
  56. /**************************************************************************/
  57. /* MAIN LOOP -- Check for GUI events                                      */
  58. /**************************************************************************/
  59. inst_a = 1   /* set instrument numbers */
  60. inst_b = 1
  61. inst_c = 1
  62. inst_d = 1
  63. cluster_a = 0    /* set note clusters */
  64. cluster_b = 0
  65. cluster_c = 0
  66. cluster_d = 0
  67. blocksp = 1        /* set default spacing  mode    1= 16 lines 2 =32 line etc.. */
  68. a = 0             /* set note defaults */
  69. b = 0
  70. c = 0
  71. d = 0
  72. noteon = 25       /* set note on */
  73. track = 0      /* set default track */
  74. insttrack = 0   /* set def trk for inst selection */
  75. instsel = 1    /* set def instr for inst selection */
  76. instmsb = 0
  77. instlsb = 0
  78. bias = 0
  79. bias_add = 0
  80.  
  81. DO FOREVER
  82.    setnotes = 0
  83.    drop group cluster instname
  84.  
  85.    CALL WAITPKT("HOLLY")
  86.    packet = GETPKT("HOLLY")
  87.    IF packet ~= '00000000'x THEN DO
  88.       class = GETARG(packet)
  89.  
  90.    say class
  91.  
  92.    IF class = "CLOSEWINDOW" THEN LEAVE
  93.  
  94.    IF left( class , 7 ) = "_LENGTH" THEN DO
  95.       blocksp = right( class , 1 ) + 1    /*set block spacing mode */
  96.       if blocksp = 9 then blocksp = 16
  97.       if blocksp = 10 then blocksp = 32
  98.       END
  99.  
  100.    IF left( class , 1 ) = "A" THEN DO
  101.       group = 4 * ( right( left( class , 4 ) , 2 ) - 1 )          /* extract group id from xxNN x */
  102.       say group 'group'
  103.       cluster = right( class , 2 )                   /* extract note cluster identity */
  104.       track = 0
  105.       inst_x = inst_a
  106.       setnotes = 1                                   /* YES! lets write notes... */
  107.       END
  108.  
  109.    IF left( class , 1 ) = "B" THEN DO
  110.       group = 4 * ( right( left( class , 4 ) , 2 ) - 1 )          /* extract group id from xxNN x */
  111.       cluster = right( class , 2 )                   /* extract note cluster identity */
  112.       track = 1
  113.       inst_x = inst_b
  114.       setnotes = 1                                   /* YES! lets write notes... */
  115.       END
  116.  
  117.    IF left( class , 1 ) = "C" THEN DO
  118.       group = 4 * ( right( left( class , 4 ) , 2 ) - 1 )          /* extract group id from xxNN x */
  119.       cluster = right( class , 2 )                   /* extract note cluster identity */
  120.       track = 2
  121.       inst_x = inst_c
  122.        setnotes = 1                                   /* YES! lets write notes... */
  123.       END
  124.  
  125.    IF left( class , 1 ) = "D" THEN DO
  126.       group = 4 * ( right( left( class , 4 ) , 2 ) - 1 )          /* extract group id from xxNN x */
  127.       cluster = right( class , 2 )                   /* extract note cluster identity */
  128.       track = 3
  129.       inst_x = inst_d
  130.       setnotes = 1                                   /* YES! lets write notes... */
  131.       END
  132.  
  133.    IF left( class , 5 ) = "_BIAS" THEN DO   /* set sector to work on */
  134.       bias = right( class , 2)       /* set bias 0 1 2 3 */
  135.       bias_add = ( blocksp * 16 ) * bias
  136.       END
  137.  
  138.    IF setnotes = 1 THEN DO    /* set edit mode when setting notes */
  139.       setnotes = 0
  140.       SELECT
  141.          WHEN cluster = 0 THEN DO                         /* noteoff = 0 noteon = 25 */
  142.             a = 0
  143.             b = 0
  144.             c = 0
  145.             d = 0
  146.             END
  147.          WHEN cluster = 1 THEN DO
  148.             a = 0
  149.             b = 0
  150.             c = 0
  151.             d = noteon
  152.             END
  153.          WHEN cluster = 2 THEN DO
  154.             a = 0
  155.             b = 0
  156.             c = noteon
  157.             d = 0
  158.             END
  159.          WHEN cluster = 3 THEN DO
  160.             a = 0
  161.             b = 0
  162.             c = noteon
  163.             d = noteon
  164.             END
  165.          WHEN cluster = 4 THEN DO
  166.             a = 0
  167.             b = noteon
  168.             c = 0
  169.             d = 0
  170.             END
  171.          WHEN cluster = 5 THEN DO
  172.             a = 0
  173.             b = noteon
  174.             c = 0
  175.             d = noteon
  176.             END
  177.          WHEN cluster = 6 THEN DO
  178.             a = 0
  179.             b = noteon
  180.             c = noteon
  181.             d = 0
  182.             END
  183.          WHEN cluster = 7 THEN DO
  184.             a = 0
  185.             b = noteon
  186.             c = noteon
  187.             d = noteon
  188.             END
  189.          WHEN cluster = 8 THEN DO
  190.             a = noteon
  191.             b = 0
  192.             c = 0
  193.             d = 0
  194.             END
  195.          WHEN cluster = 9 THEN DO
  196.             a = noteon
  197.             b = 0
  198.             c = 0
  199.             d = noteon
  200.             END
  201.          WHEN cluster = 10 THEN DO
  202.             a = noteon
  203.             b = 0
  204.             c = noteon
  205.             d = 0
  206.             END
  207.          WHEN cluster = 11 THEN DO
  208.             a = noteon
  209.             b = 0
  210.             c = noteon
  211.             d = noteon
  212.             END
  213.          WHEN cluster = 12 THEN DO
  214.             a = noteon
  215.             b = noteon
  216.             c = 0
  217.             d = 0
  218.             END
  219.          WHEN cluster = 13 THEN DO
  220.             a = noteon
  221.             b = noteon
  222.             c = 0
  223.             d = noteon
  224.             END
  225.          WHEN cluster = 14 THEN DO
  226.             a = noteon
  227.             b = noteon
  228.             c = noteon
  229.             d = 0
  230.             END
  231.          WHEN cluster = 15 THEN DO
  232.             a = noteon
  233.             b = noteon
  234.             c = noteon
  235.             d = noteon
  236.             END
  237.          OTHERWISE DO
  238.             END
  239.          END                   /* end select  */
  240.  
  241.          ADDRESS OCTAMED_REXX
  242.          'op_update off'
  243.          IF a ~= 0 THEN 'ed_setdata l ' bias_add + ( 0 + group ) * blocksp 't' track 'inum ' inst_x ' note ' a
  244.          IF b ~= 0 THEN 'ed_setdata l ' bias_add + ( 1 + group ) * blocksp 't' track 'inum ' inst_x ' note ' b
  245.          IF c ~= 0 THEN 'ed_setdata l ' bias_add + ( 2 + group ) * blocksp 't' track 'inum ' inst_x ' note ' c
  246.          IF d ~= 0 THEN 'ed_setdata l ' bias_add + ( 3 + group ) * blocksp 't' track 'inum ' inst_x ' note ' d
  247.  
  248.          IF a  = 0 THEN 'ed_setdata l ' bias_add + ( 0 + group ) * blocksp 't' track 'inum 0 note 0'
  249.          IF b  = 0 THEN 'ed_setdata l ' bias_add + ( 1 + group ) * blocksp 't' track 'inum 0 note 0'
  250.          IF c  = 0 THEN 'ed_setdata l ' bias_add + ( 2 + group ) * blocksp 't' track 'inum 0 note 0'
  251.          IF d  = 0 THEN 'ed_setdata l ' bias_add + ( 3 + group ) * blocksp 't' track 'inum 0 note 0'
  252.  
  253.          'op_update on'
  254.  
  255.          ADDRESS VALUE vhost
  256.  
  257.       END     /* end IF setdata loop */
  258.  
  259. /* ACCENT SETTING LOOP */
  260.    IF left( class , 1 ) = 'K' THEN DO     /* if aKcenting */
  261.       IF right( left( class , 2 ) , 1 ) = "A" THEN DO
  262.          group = 4 * ( right( left( class , 4 ) , 2 ) - 1 )
  263.          cluster = right( class , 2 )
  264.          track = 0
  265.          END
  266.       IF right( left( class , 2 ) , 1 ) = "B" THEN DO
  267.          group = 4 * ( right( left( class , 4 ) , 2 ) - 1 )
  268.          cluster = right( class , 2 )
  269.         track = 1
  270.          END
  271.       IF right( left( class , 2 ) , 1 ) = "C" THEN DO
  272.          group = 4 * ( right( left( class , 4 ) , 2 ) - 1 )
  273.          cluster = right( class , 2 )
  274.          track = 2
  275.          END
  276.       IF right( left( class , 2 ) , 1 ) = "D" THEN DO
  277.          group = 4 * ( right( left( class , 4 ) , 2 ) - 1 )
  278.          cluster = right( class , 2 )
  279.          track = 3
  280.          END
  281.  
  282.       say 'accent gp' group 'cl' cluster
  283.  
  284.       SELECT
  285.          WHEN cluster = 0 THEN DO
  286.             acc1 = 99
  287.             acc2 = 99
  288.             acc3 = 99
  289.             acc4 = 99
  290.             END
  291.          WHEN cluster = 1 THEN DO
  292.             acc1 = 99
  293.             acc2 = 50
  294.             acc3 = 99
  295.             acc4 = 50
  296.             END
  297.          WHEN cluster = 2 THEN DO
  298.             acc1 = 99
  299.             acc2 = 50
  300.             acc3 = 25
  301.             acc4 = 50
  302.              END
  303.          WHEN cluster = 3 THEN DO
  304.             acc1 = 99
  305.             acc2 = 25
  306.             acc3 = 50
  307.             acc4 = 25
  308.              END
  309.          WHEN cluster = 4 THEN DO
  310.             acc1 = 99
  311.             acc2 = 1
  312.             acc3 = 99
  313.             acc4 = 1
  314.              END
  315.          WHEN cluster = 5 THEN DO
  316.             acc1 = 99
  317.             acc2 = 1
  318.             acc3 = 50
  319.             acc4 = 1
  320.              END
  321.          WHEN cluster = 6 THEN DO
  322.             acc1 = 25
  323.             acc2 = 50
  324.             acc3 = 99
  325.             acc4 = 99
  326.              END
  327.          WHEN cluster = 7 THEN DO
  328.             acc1 = 25
  329.             acc2 = 99
  330.             acc3 = 50
  331.             acc4 = 99
  332.              END
  333.          OTHERWISE DO
  334.             END
  335.          END
  336.  
  337.          ADDRESS OCTAMED_REXX   /* set accent data */
  338.          'op_update off'
  339.          'ed_setdata l '  bias_add + ( 0 + group ) * blocksp 't' track 'cmdnum 12 qual' acc1
  340.          'ed_setdata l '  bias_add + ( 1 + group ) * blocksp 't' track 'cmdnum 12 qual' acc2
  341.          'ed_setdata l '  bias_add + ( 2 + group ) * blocksp 't' track 'cmdnum 12 qual' acc3
  342.          'ed_setdata l '  bias_add + ( 3 + group ) * blocksp 't' track 'cmdnum 12 qual' acc4
  343.          'op_update on'
  344.          ADDRESS VALUE vhost
  345.       END
  346.  
  347. /* END OF ACCENT SET LOOP */
  348.  
  349.  
  350. /* setting inst_x commands */
  351.    drop instname
  352.    IF left( class , 5 ) = "_SETA" THEN DO
  353.       IF left( class , 6 ) = "_SETAL" THEN DO
  354.          IF inst_a > 1 THEN inst_a = inst_a - 1
  355.          END
  356.       IF left( class , 6 ) = "_SETAG" THEN DO
  357.          IF inst_a < 64 THEN inst_a = inst_a + 1
  358.          END
  359.       IF left( class , 8 ) = "_SETAGET" THEN DO
  360.          drop inst_a
  361.          ADDRESS OCTAMED_REXX
  362.          in_getnumber var inst_a
  363.          END
  364.       ADDRESS OCTAMED_REXX
  365.       'in_select' inst_a
  366.       'in_getname' VAR instname
  367.       ADDRESS VALUE vhost
  368.       'settext trk1 ' left( instname, 14 )
  369.       END
  370.    IF left( class , 5 ) = "_SETB" THEN DO
  371.       IF left( class , 6 ) = "_SETBL" THEN DO
  372.          IF inst_b > 1 THEN inst_b = inst_b - 1
  373.          END
  374.       IF left( class , 6 ) = "_SETBG" THEN DO
  375.          IF inst_b < 64 THEN inst_b = inst_b + 1
  376.          END
  377.       IF left( class , 8 ) = "_SETBGET" THEN DO
  378.          drop inst_b
  379.          ADDRESS OCTAMED_REXX
  380.          in_getnumber var inst_b
  381.          END
  382.       ADDRESS OCTAMED_REXX
  383.       'in_select' inst_b
  384.       'in_getname' VAR instname
  385.       ADDRESS VALUE vhost
  386.       'settext trk2 ' left( instname, 14 )
  387.       END
  388.    IF left( class , 5 ) = "_SETC" THEN DO
  389.       IF left( class , 6 ) = "_SETCL" THEN DO
  390.          IF inst_c > 1 THEN inst_c = inst_c - 1
  391.          END
  392.       IF left( class , 6 ) = "_SETCG" THEN DO
  393.          IF inst_c < 64 THEN inst_c = inst_c + 1
  394.          END
  395.       IF left( class , 8 ) = "_SETCGET" THEN DO
  396.          drop inst_c
  397.          ADDRESS OCTAMED_REXX
  398.          in_getnumber var inst_c
  399.          END
  400.       ADDRESS OCTAMED_REXX
  401.       'in_select' inst_c
  402.       'in_getname' VAR instname
  403.       ADDRESS VALUE vhost
  404.       'settext trk3 ' left( instname, 14 )
  405.       END
  406.    IF left( class , 5 ) = "_SETD" THEN DO
  407.       IF left( class , 6 ) = "_SETDL" THEN DO
  408.          IF inst_d > 1 THEN inst_d = inst_d - 1
  409.          END
  410.       IF left( class , 6 ) = "_SETDG" THEN DO
  411.          IF inst_d < 64 THEN inst_d = inst_d + 1
  412.          END
  413.       IF left( class , 8 ) = "_SETDGET" THEN DO
  414.          drop inst_d
  415.          ADDRESS OCTAMED_REXX
  416.          in_getnumber var inst_d
  417.          END
  418.       ADDRESS OCTAMED_REXX
  419.       'in_select' inst_d
  420.       'in_getname' VAR instname
  421.       ADDRESS VALUE vhost
  422.       'settext trk4 ' left( instname, 14 )
  423.       END
  424.  
  425. /* end of inst select segment */
  426.  
  427.    IF left( class , 4 ) = "_NEW" THEN DO
  428.       say 'clearing...'
  429.       say right( left( class , 6 ) , 2 )
  430.       IF right( left( class , 6 ) , 2 ) = "A1" THEN DO
  431.          ADDRESS OCTAMED_REXX
  432.          'ed_goto track 0'
  433.          'rn_erase track'
  434.          ADDRESS VALUE vhost
  435.          setnum A101 0
  436.          setnum A102 0
  437.          setnum A103 0
  438.          setnum A104 0
  439.          setnum KA01 0
  440.          setnum KA02 0
  441.          setnum KA03 0
  442.          setnum KA04 0
  443.            END
  444.       IF right( left( class , 6 ) , 2 ) = "AA" THEN DO
  445.          END
  446.       IF right( left( class , 6 ) , 2 ) = "B1" THEN DO
  447.          ADDRESS OCTAMED_REXX
  448.          'ed_goto track 1'
  449.          'rn_erase track'
  450.          ADDRESS VALUE vhost
  451.          setnum B101 0
  452.          setnum B102 0
  453.          setnum B103 0
  454.          setnum B104 0
  455.          setnum KB01 0
  456.          setnum KB02 0
  457.          setnum KB03 0
  458.          setnum KB04 0
  459.          END
  460.       IF right( left( class , 6 ) , 2 ) = "BA" THEN DO
  461.          /* clear track 0 COMMANDS */
  462.          END
  463.       IF right( left( class , 6 ) , 2 ) = "C1" THEN DO
  464.          ADDRESS OCTAMED_REXX
  465.          'ed_goto track 2'
  466.          'rn_erase track'
  467.          ADDRESS VALUE vhost
  468.          setnum C101 0
  469.          setnum C102 0
  470.          setnum C103 0
  471.          setnum C104 0
  472.          setnum KC01 0
  473.          setnum KC02 0
  474.          setnum KC03 0
  475.          setnum KC04 0
  476.          END
  477.       IF right( left( class , 6 ) , 2 ) = "CA" THEN DO
  478.          /* clear track 0 COMMANDS */
  479.          END
  480.       IF right( left( class , 6 ) , 2 ) = "D1" THEN DO
  481.          ADDRESS OCTAMED_REXX
  482.          'ed_goto track 3'
  483.          'rn_erase track'
  484.          ADDRESS VALUE vhost
  485.          setnum D101 0
  486.          setnum D102 0
  487.          setnum D103 0
  488.          setnum D104 0
  489.          setnum KD01 0
  490.          setnum KD02 0
  491.          setnum KD03 0
  492.          setnum KD04 0
  493.          END
  494.       IF right( left( class , 6 ) , 2 ) = "DA" THEN DO
  495.          /* clear track 0 COMMANDS */
  496.          END
  497.       END
  498.  
  499.    IF left( class , 3 ) = "_GO" THEN DO
  500.       ADDRESS OCTAMED_REXX
  501.       IF class = "_GO6" THEN DO
  502.          ed_advanceline fkey 6
  503.          END
  504.       IF class = "_GO7" THEN DO
  505.          ed_advanceline fkey 7
  506.          END
  507.       IF class = "_GO8" THEN DO
  508.          ed_advanceline fkey 8
  509.          END
  510.       IF class = "_GO9" THEN DO
  511.          ed_advanceline fkey 9
  512.          END
  513.       ADDRESS VALUE vhost
  514.       END
  515.  
  516.    IF class = "_UPDATE" THEN DO
  517.       ADDRESS OCTAMED_REXX
  518.       op_update off
  519.       pl_stop
  520.       ed_goto l 0 t 0
  521.       rn_setrange 0 0 3 (blocksp * 16)
  522.       rn_copy range
  523.       ed_advanceline fkey 7
  524.       rn_paste range
  525.       ed_advanceline fkey 8
  526.       rn_paste range
  527.       ed_advanceline fkey 9
  528.       rn_paste range
  529.       op_update on
  530.       pl_playblock
  531.       ADDRESS VALUE vhost
  532.       END
  533.  
  534.    IF class = "_APPEND" THEN DO
  535.       ADDRESS OCTAMED_REXX
  536.       pl_stop
  537.       ed_newblock append clonecurr            /* add new block to end */
  538.       rn_copy block                           /* copy current block into block buffer */
  539.       ed_gotoblock last firstline             /* move to last block */
  540.       rn_paste block                          /* paste block buffer to the NEW block  */
  541.       pl_playblock
  542.       ADDRESS VALUE vhost
  543.       END
  544.  
  545.    IF class = "_INSERT" THEN DO
  546.       ADDRESS OCTAMED_REXX
  547.       pl_stop
  548.       rn_copy block                           /* copy current block into block buffer */
  549.       ed_newblock insert clonecurr            /* insert new block to end */
  550.       rn_paste block                          /* paste block buffer to the NEW block  */
  551.       pl_playblock
  552.       ADDRESS VALUE vhost
  553.       END
  554.  
  555.     IF class = "_PLAY" THEN DO
  556.        ADDRESS OCTAMED_REXX
  557.        pl_playblock
  558.        ADDRESS VALUE vhost
  559.        END
  560.  
  561.     IF class = "_STOP" THEN DO
  562.        ADDRESS OCTAMED_REXX
  563.        pl_stop
  564.        ADDRESS VALUE vhost
  565.        END
  566.  
  567.     IF class = "_CLEAR" THEN DO
  568.        ADDRESS OCTAMED_REXX
  569.        'ed_goto track 0'
  570.        'rn_erase track'
  571.        'ed_goto track 1'
  572.        'rn_erase track'
  573.        'ed_goto track 2'
  574.        'rn_erase track'
  575.        'ed_goto track 3'
  576.        'rn_erase track'
  577.        ADDRESS VALUE vhost
  578.          END
  579.  
  580.     END
  581. END
  582.  
  583.     'hide unload'    
  584.  
  585.     CALL CLOSEPORT( "HOLLY" )
  586. EXIT
  587.  
  588. /* Error messages */
  589. failure:
  590.     SAY "Error code" rc "-- Line" SIGL
  591.     SAY EXTERNERROR
  592.     'hide unload'
  593.     CALL CLOSEPORT ("HOLLY")
  594.  
  595. EXIT
  596.  
  597. syntax:
  598.     SAY "Error" rc  "-- Line" SIGL
  599.     SAY ERRORTEXT( rc )
  600.     'hide unload'
  601.     CALL CLOSEPORT ("HOLLY")
  602. EXIT
  603.  
  604.  
  605.  
  606.